home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Workbench Add-On
/
Workbench Add-On - Volume 1.iso
/
Dev
/
Oberon
/
source
/
FPE
/
StringDialog.mod
< prev
next >
Wrap
Text File
|
1995-06-29
|
9KB
|
341 lines
(***************************************************************************
$RCSfile: StringDialog.mod $
Description: Defines and implements a simple string dialog.
Created by: fjc (Frank Copeland)
$Revision: 1.10 $
$Author: fjc $
$Date: 1995/06/04 22:42:36 $
Copyright © 1994-1995, Frank Copeland.
This file is part of the Oberon-A Library.
See Oberon-A.doc for conditions of use and distribution.
Log entries are at the end of the file.
***************************************************************************)
<* STANDARD- *> <* MAIN- *> <*$ LongVars+ *> <*$ NilChk- *>
MODULE StringDialog;
IMPORT
SYS := SYSTEM, e := Exec, gfx := Graphics, i := Intuition,
iu := IntuiUtil, ev := Events, is := IntuiSup, ise := ISupEvents,
u := Util;
CONST
NumGadgets = 3;
NumTexts = 1;
TYPE
StrDlg * = POINTER TO StrDlgRec;
StrDlgRec = RECORD (ise.ISupDialogRec)
g0 : is.InputData;
g1 : is.ButtonData;
g2 : is.ButtonData;
gDataEnd : LONGINT;
t0 : is.TextData;
tDataEnd : INTEGER;
textBuffer : ARRAY 256 OF CHAR;
result : BOOLEAN;
END; (* StrDlgRec *)
StrDlgPort = POINTER TO StrDlgPortRec;
StrDlgPortRec = RECORD (ise.ISupPortRec)
strDlg : StrDlg;
END;
CONST
AcceptText = "_Accept";
CancelText = "_Cancel";
StringGadgetID = 0;
AcceptButtonID = 1;
CancelButtonID = 2;
(* ----- Support procedures ----- *)
(*------------------------------------*)
PROCEDURE CalcTextBox
( renderInfo : is.RenderInfoPtr;
text : ARRAY OF CHAR;
font : gfx.TextAttrPtr;
VAR width, height : INTEGER );
<*$CopyArrays-*>
BEGIN (* CalcTextBox *)
IF font = NIL THEN font := SYS.ADR(renderInfo.textAttr) END;
iu.CalcTextBox (text, font, width, height);
END CalcTextBox;
(*------------------------------------*)
PROCEDURE CalcTextButtonBox
( renderInfo : is.RenderInfoPtr;
text : ARRAY OF CHAR;
font : gfx.TextAttrPtr;
VAR width, height : INTEGER );
CONST
extraWidth = 10;
extraHeight = 6;
VAR
tempWidth, tempHeight : INTEGER;
<*$CopyArrays-*>
BEGIN (* CalcTextButtonBox *)
CalcTextBox (renderInfo, text, font, tempWidth, tempHeight);
INC (tempWidth, extraWidth);
INC (tempHeight, extraHeight);
IF tempWidth > width THEN
width := tempWidth;
END;
IF tempHeight > height THEN
height := tempHeight;
END
END CalcTextButtonBox;
(*------------------------------------*)
PROCEDURE CalcInputGadgetBox
( renderInfo : is.RenderInfoPtr;
visibleChars : INTEGER;
VAR width, height : INTEGER );
CONST
extraWidth = 12;
extraHeight = 6;
VAR
tempWidth, tempHeight : INTEGER;
BEGIN (* CalcInputGadgetBox *)
CalcTextBox (renderInfo, "0", NIL, tempWidth, tempHeight);
tempWidth := tempWidth * visibleChars;
INC (tempWidth, extraWidth);
INC (tempHeight, extraHeight);
IF tempWidth > width THEN
width := tempWidth;
END;
IF tempHeight > height THEN
height := tempHeight;
END
END CalcInputGadgetBox;
(*------------------------------------*)
PROCEDURE (sdp : StrDlgPort) HandleISup
(msg : i.IntuiMessagePtr) : INTEGER;
VAR result : INTEGER; str : e.LSTRPTR;
BEGIN (* HandleISup *)
CASE msg.code OF
StringGadgetID :
str := msg.iAddress;
COPY (str^, sdp.strDlg.textBuffer);
result := ev.Continue
|
AcceptButtonID :
sdp.strDlg.result := (sdp.strDlg.textBuffer # "");
result := ev.Stop
|
CancelButtonID :
sdp.strDlg.result := FALSE;
result := ev.Stop
|
END;
is.ReplyMsg (msg);
RETURN result;
END HandleISup;
(*------------------------------------------------------------------------*)
(* Exported procedures *)
(*------------------------------------*)
PROCEDURE InitStrDlg *
( dialog : StrDlg;
renderInfo : is.RenderInfoPtr;
title, prompt : ARRAY OF CHAR;
visibleChars,
maxChars : INTEGER );
CONST
HSpace = 8; VSpace = 4;
VAR
textWidth, textHeight, stringWidth, stringHeight, buttonWidth,
buttonHeight, dialogWidth, dialogHeight
: INTEGER;
sdp : StrDlgPort;
(*------------------------------------*)
PROCEDURE CalcStrDlg ();
BEGIN (* CalcStrDlg *)
CalcTextBox (renderInfo, prompt, NIL, textWidth, textHeight);
stringWidth := 0; stringHeight := 0;
CalcInputGadgetBox (
renderInfo, visibleChars, stringWidth, stringHeight);
buttonWidth := 0; buttonHeight := 0;
CalcTextButtonBox (
renderInfo, AcceptText, NIL, buttonWidth, buttonHeight);
CalcTextButtonBox (
renderInfo, CancelText, NIL, buttonWidth, buttonHeight);
dialogWidth :=
u.MaxInt
( u.MaxInt (textWidth, stringWidth), (buttonWidth * 2) + HSpace )
+ (2 * HSpace);
dialogHeight := textHeight + stringHeight + buttonHeight + (4 * VSpace);
END CalcStrDlg;
(*------------------------------------*)
PROCEDURE InitTexts (dialog : StrDlg);
BEGIN (* InitTexts *)
dialog.t0.type := is.text;
dialog.t0.flags := {is.tdCenter};
dialog.t0.leftEdge := 0;
dialog.t0.topEdge := VSpace;
dialog.t0.text := SYS.ADR (prompt);
dialog.t0.textAttr := NIL;
dialog.tDataEnd := is.dataEnd;
END InitTexts;
(*------------------------------------*)
PROCEDURE InitGadgets (dialog : StrDlg);
CONST
StringGadgetFlags = {is.gdMovePointer};
ButtonFlags = {is.gdHotKey};
VAR halfWidth : INTEGER;
BEGIN (* InitGadgets *)
dialog.g0.type := is.string;
dialog.g0.flags := StringGadgetFlags;
dialog.g0.leftEdge := (dialogWidth - stringWidth) DIV 2;
dialog.g0.topEdge := textHeight + (2 * VSpace);
dialog.g0.width := stringWidth;
dialog.g0.height := stringHeight;
dialog.g0.text := NIL;
dialog.g0.textAttr := NIL;
dialog.g0.len := maxChars;
dialog.g0.activateNext := 0;
dialog.g0.activatePrev := 0;
dialog.g0.default := NIL;
halfWidth := dialogWidth DIV 2;
dialog.g1.type := is.button;
dialog.g1.flags := ButtonFlags;
dialog.g1.leftEdge := (halfWidth - buttonWidth) DIV 2;
dialog.g1.topEdge := dialog.g0.topEdge + stringHeight + VSpace;
dialog.g1.width := buttonWidth;
dialog.g1.height := buttonHeight;
dialog.g1.text := SYS.ADR(AcceptText);
dialog.g1.textAttr := NIL;
dialog.g1.selected := 0;
dialog.g1.normalRender := NIL;
dialog.g1.selectRender := NIL;
dialog.g2.type := is.button;
dialog.g2.flags := ButtonFlags;
dialog.g2.leftEdge := dialog.g1.leftEdge + halfWidth;
dialog.g2.topEdge := dialog.g1.topEdge;
dialog.g2.width := buttonWidth;
dialog.g2.height := buttonHeight;
dialog.g2.text := SYS.ADR(CancelText);
dialog.g2.textAttr := NIL;
dialog.g2.selected := 0;
dialog.g2.normalRender := NIL;
dialog.g2.selectRender := NIL;
dialog.gDataEnd := is.dataEnd;
END InitGadgets;
<*$CopyArrays-*>
BEGIN (* InitStrDlg *)
ASSERT (dialog # NIL, 137);
CalcStrDlg ();
dialog.reqData.title := SYS.ADR (title);
dialog.reqData.width := dialogWidth;
dialog.reqData.height := dialogHeight;
dialog.reqData.flags := {is.rdInnerWindow};
dialog.reqData.texts := SYS.ADR (dialog.t0);
dialog.reqData.gadgets := SYS.ADR (dialog.g0);
InitTexts (dialog);
InitGadgets (dialog);
dialog.result := FALSE;
NEW (sdp); ASSERT (sdp # NIL, 132);
sdp.strDlg := dialog; dialog.iSupPort := sdp
END InitStrDlg;
(*------------------------------------*)
PROCEDURE Activate *
( dialog : StrDlg;
window : i.WindowPtr;
VAR buffer : ARRAY OF CHAR )
: BOOLEAN;
BEGIN (* Activate *)
ASSERT (dialog # NIL, 137);
dialog.g0.default := SYS.ADR (buffer);
dialog.textBuffer := ""; dialog.result := FALSE;
IF ise.Activate (dialog, window) THEN
IF dialog.result THEN COPY (dialog.textBuffer, buffer) END
END;
RETURN dialog.result
END Activate;
END StringDialog.
(***************************************************************************
$Log: StringDialog.mod $
Revision 1.10 1995/06/04 22:42:36 fjc
*** empty log message ***
Revision 1.9 1995/01/26 00:15:33 fjc
- Release 1.5
Revision 1.8 1994/09/25 18:20:54 fjc
- Uses new syntax for external code declarations
Revision 1.7 1994/08/08 16:13:41 fjc
Release 1.4
Revision 1.6 1994/06/17 17:26:27 fjc
- Updated for release
Revision 1.5 1994/06/09 13:42:30 fjc
- [bug] The text entered into the input gadget was in a
buffer dynamically allocated by IntuiSup. This was being
freed before the text was copied. Changed to copy the
text into the dialog object instead of just keeping a
pointer to it.
Revision 1.4 1994/06/04 23:49:52 fjc
- Changed to use new Amiga interface
Revision 1.3 1994/05/12 21:26:09 fjc
- Prepared for release
Revision 1.2 1994/01/24 14:33:33 fjc
Changed to conform with changes in Module Handlers:
Handler procedures now reply to any messages they handle
Revision 1.1 1994/01/15 17:32:38 fjc
Start of revision control
***************************************************************************)